library(vroom)
library(sf)
library(ggplot2)
library(ggmap)
library(kableExtra)
library(tidyverse)
library(data.table)
#remotes::install_github("CityOfPhiladelphia/rphl")
library(rphl)
library(lubridate)
library(furrr)
library(tidycensus)
library(rgdal)
library(furrr)
library(mapview)
ll <- function(dat, proj4 = 4326){st_transform(dat, proj4)}

root.dir = "https://raw.githubusercontent.com/urbanSpatial/Public-Policy-Analytics-Landing/master/DATA/"
source("https://raw.githubusercontent.com/urbanSpatial/Public-Policy-Analytics-Landing/master/functions.r")

#windowsFonts(font = windowsFont('Helvetica'))

crs = 'EPSG:2272'

plotTheme <- function(base_size = 9, title_size = 10){
  theme(
    text = element_text( color = "black"),
    plot.title = element_text(size = title_size, colour = "black", hjust = 0.5), 
    plot.subtitle = element_text( face = 'italic',
                                 size = base_size, colour = "black", hjust = 0.5),
    plot.caption = element_text( hjust=0),
    axis.ticks = element_blank(),
    panel.background = element_blank(),
    panel.grid.major = element_line("grey80", size = 0.01),
    panel.grid.minor = element_blank(),
    panel.border = element_rect(colour = "black", fill=NA, size=.5),
    strip.background = element_blank(),
    strip.text = element_text( size=9),
    axis.title = element_text( size=9),
    axis.text = element_text( size=7),
    axis.text.y = element_text( size=7),
    plot.background = element_blank(),
    legend.background = element_blank(),
    legend.title = element_text( colour = "black", face = "italic", size = 9),
    legend.text = element_text( colour = "black", face = "italic", size = 7),
    strip.text.x = element_text( size = 9),
    legend.key.size = unit(.5, 'line')
  )
}

mapTheme <- function(base_size = 9, title_size = 10){
  theme(
    text = element_text( color = "black"),
    plot.title = element_text(size = title_size, colour = "black", hjust = 0.5), 
    plot.subtitle = element_text( face = 'italic',
                                 size = base_size, colour = "black", hjust = 0.5),
    plot.caption = element_text( hjust=0),
    axis.ticks = element_blank(),
    panel.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    strip.background = element_blank(),
    strip.text = element_text(size=base_size),
    axis.title = element_text( size=9),
    axis.text = element_blank(),
    axis.text.y = element_blank(),
    plot.background = element_blank(),
    legend.background = element_blank(),
    legend.title = element_text( colour = "black", face = "italic", size = 9),
    legend.text = element_text( colour = "black", face = "italic", size = 7),
    strip.text.x = element_text(size=base_size),
    legend.key.size = unit(.5, 'line')
  )
}

palette5 <- c("#f9b294","#f2727f","#c06c86","#6d5c7e","#315d7f")
palette4 <- c("#f9b294","#f2727f","#c06c86","#6d5c7e")
palette2 <- c("#f9b294","#f2727f")
palette1_main <- "#F2727F"
palette1_assist <- '#F9B294'
## NOTE: You will need to create secrets.json, using the template
## to enter private credentials for interacting with the database

get_secrets <- function() {
  path <- "secrets/secrets.json"
  if (!file.exists(path)) {
    stop("Can't find secret file: '", path, "'")
  }
  
  jsonlite::read_json(path)
}
#secrets <- get_secrets()

# database settings
# dbname = secrets$db_name
# host = secrets$db_host
# port = secrets$db_port
# username =  secrets$db_username
# password = secrets$db_password
# census_api_key(secrets$census_api_key, install=TRUE, overwrite=TRUE)

Data Loading

Folder: SafeGraph

These two datasets (‘brand_info’ and ‘core_poi’ from safegraph) are dictionary data.

#HPS = home_panel_summary
#NS = normalization_stats
#VPS = visit_panel_summary

monthList = c("01","02","03","04","05","06","07","08","09","10","11")

# home_panel_summary
hpsAllMonth = data.frame()

for (i in monthList){
  currentMonth = vroom(paste("data/safegraph/SafeGraph Data Purchase Dec-16-2021/Philadelphia-Camden-WilmingtonPA-NJ-DE-MDMSA-PATTERNS-2021_",
       i,
       "-2021-12-17/home_panel_summary.csv",sep = ""))%>%
    filter(region=="pa")
  hpsAllMonth = rbind(hpsAllMonth,currentMonth)
  #print(paste("Current input home_panel_summary dataframe is in ",i," month",sep = ""))
}

# kable(head(hpsAllMonth,3),align = 'c',caption = '<center>Table 3. home pannel summary of 2021 whole year in SafeGraph data <center/>')%>%
#   kable_classic(full_width = F)%>%
#   kable_styling(position = "center")%>% 
#   scroll_box(width = "100%", height = "400px")

# normalization_Stats
nsAllMonth = data.frame()

for (i in monthList){
  currentMonth = vroom(paste("data/safegraph/SafeGraph Data Purchase Dec-16-2021/Philadelphia-Camden-WilmingtonPA-NJ-DE-MDMSA-PATTERNS-2021_",
       i,
       "-2021-12-17/normalization_stats.csv",sep = ""))%>%
    filter(region=="pa")
  nsAllMonth = rbind(nsAllMonth,currentMonth)
  #print(paste("Current input normalization_stats dataframe is in ",i," month",sep = ""))
}

# kable(head(nsAllMonth,3),align = 'c',caption = '<center>Table 4. normalization stats of 2021 whole year in SafeGraph data <center/>')%>%
#   kable_classic(full_width = F)%>%
#   kable_styling(position = "center")%>% 
#   scroll_box(width = "100%", height = "400px")

# visit_panel_summary
vpsAllMonth = data.frame()

for (i in monthList){
  currentMonth = vroom(paste("data/safegraph/SafeGraph Data Purchase Dec-16-2021/Philadelphia-Camden-WilmingtonPA-NJ-DE-MDMSA-PATTERNS-2021_",
       i,
       "-2021-12-17/visit_panel_summary.csv",sep = ""))%>%
    filter(region=="pa")
  vpsAllMonth = rbind(vpsAllMonth,currentMonth)
  #print(paste("Current input visit_panel_summary dataframe is in ",i," month",sep = ""))
}

# kable(head(vpsAllMonth,3),align = 'c',caption = '<center>Table 5. visit panel summary of 2021 whole year in SafeGraph data <center/>')%>%
#   kable_classic(full_width = F)%>%
#   kable_styling(position = "center")%>% 
#   scroll_box(width = "100%", height = "400px")

# Pattern
patternAllMonth = data.frame()

for (i in monthList){
  currentMonth = vroom(paste("data/safegraph/SafeGraph Data Purchase Dec-16-2021/Philadelphia-Camden-WilmingtonPA-NJ-DE-MDMSA-PATTERNS-2021_",
       i,
       "-2021-12-17/patterns.csv.gz",sep = ""))%>%
    filter(region=="PA")%>%
    mutate(month=paste(i,sep = ""))
  patternAllMonth = rbind(patternAllMonth,currentMonth)
  #print(paste("Current input patterns dataframe is in ",i," month",sep = ""))
}

# kable(head(patternAllMonth,3),align = 'c',caption = '<center>Table 6. patterns of 2021 whole year in SafeGraph data <center/>')%>%
#   kable_classic(full_width = F)%>%
#   kable_styling(position = "center")%>% 
#   scroll_box(width = "100%", height = "400px")

This is the whole safegraph raw data, it has four datasets. One is the aggregated pattern data for 2021 whole year. That is the primary one for this project. And the other two datasets give information about the number of active devices.

Folder: OpenDataPhilly

Relevant data of PPR finder

philly <- st_read("https://opendata.arcgis.com/datasets/405ec3da942d4e20869d4e1449a2be48_0.geojson")

pprDistrict <- st_read('https://opendata.arcgis.com/datasets/0cdc4a1e86c6463b9600f9d9fca39875_0.geojson') %>%
  st_transform(crs)

destDistrict <- pprDistrict %>% filter(DISTRICTID %in% c(7,8,9))

base_map <- get_map(location = unname(st_bbox(ll(st_buffer(st_union(pprDistrict),11000)))),maptype = "terrian")

ggmap(base_map) + 
  geom_sf(data=ll(st_union(pprDistrict)),color="black",size=2,fill = "transparent",inherit.aes = FALSE)+
  geom_sf(data=ll(pprDistrict),color='black',size=2,fill = "transparent",inherit.aes = FALSE)+
  geom_sf(data=ll(destDistrict),color=palette1_main,size=2,fill = "transparent",inherit.aes = FALSE)+
  labs(title = "", 
       subtitle = "",
       x="",y="")+
  mapTheme()
Figure 1. Locations of pprDistrict

Figure 1. Locations of pprDistrict

The whole Philadelphia is divided into 10 PPR districts, and the project mainly focus on the District 7、8、9 as pilot project which are highlighted in the map using the color red. Note: The 9 district does not include the Smith Area.

pprProperties <- st_read('https://opendata.arcgis.com/datasets/d52445160ab14380a673e5849203eb64_0.geojson')%>%
  st_transform(crs)

ggplot() + 
  geom_sf(data=pprProperties,color=palette1_main,fill = palette1_main)+
  geom_sf(data=st_union(pprDistrict),color="black",size=2,fill = "transparent")+
  geom_sf(data=pprDistrict,color="black",size=1,linetype ="dashed",fill = "transparent")+
  labs(title = "", 
       subtitle = "",
       x="",y="")+
  mapTheme()
Figure 2. Locations of pprProperties

Figure 2. Locations of pprProperties

And there are other datasets from the PPR finder unused right now. They are datasets about the types, number and quality of facilities of PPR.

Folder: FromPPR

These are datasets directly from PPR officers. These datasets are highly related to our project.

pprServiceArea <- read_sf(dsn="data/FromPPR/PPR_Service_Areas_2021/PPR_Service_Areas_2021.shp")%>%
  st_transform(crs = crs)

pprDestServiceArea <- pprServiceArea %>% filter(PPR_DIST %in% c(7,8,9))

ggplot() + 
  geom_sf(data=pprServiceArea,color='black',size=1,fill = "transparent")+
  geom_sf(data=pprDestServiceArea,color=palette1_main,size=2,fill = "transparent")+
  geom_sf(data=st_union(pprDistrict),color="black",size=2,fill = "transparent")+
  labs(title = "", 
       subtitle = "",
       x="",y="")+
  mapTheme()
Figure 15. Locations of pprServiceArea

Figure 15. Locations of pprServiceArea

The above map is about service areas. Each district unit is divided into several service area units for the sake of administration. The pink lines in the map are the services areas in District 7,8,9. These service areas are the target of this project.

program2021 <- vroom("data/FromPPR/PPR-programs-attended-2021-with-schedules.csv")
kable(head(program2021,3),align = 'c',caption = '<center>Table 8. Program information of PPR Programs data <center/>')%>%
  kable_classic(full_width = F)%>%
  kable_styling(position = "center")%>% 
  scroll_box(width = "100%", height = "460px")
Table 8. Program information of PPR Programs data
FacilityID Facility ProgramID ActvityTypeCategory ActivityType Gender AgeLow AgeHigh AttendanceWeekDate RegisteredIndividualsCount UniqueIndividualCount ProgramScheduleID DateFrom DateTo Days TimeFrom TimeTo
{C8420FF3-289F-4737-A4F5-FF44DE89CA58} McVeigh Recreation Center 300 After School After School M/F 6 12 12/27/2021 21 0 8348 9/13/2021 5/27/2022 Monday Tuesday Wednesday Thursday Friday 15:00:00 18:00:00
{DA9F8E3A-D19A-46DD-9040-5ACE360CDD2A} Kendrick Recreation Center 4800 Athletic Gymnastics / Tumbling M/F 3 5 12/13/2021 12 12 8883 12/6/2021 2/26/2022 Thursday 17:30:00 18:30:00
{DA9F8E3A-D19A-46DD-9040-5ACE360CDD2A} Kendrick Recreation Center 4800 Athletic Gymnastics / Tumbling M/F 3 5 12/13/2021 12 12 8504 9/16/2021 11/18/2021 Thursday 17:30:00 18:30:00

The above dataset gives information about PPR programs in 2021, including information like the duration of the program, the attendence of the program etc. But some wrangling are needed for further uses. And the wrangling is taken in the next section.

facilityID <- read.csv("data/FromPPR/tblFacility_to_PPR_Properties.csv")

The above dataset is offered as dictionary data to provide links between facility id and PPR property object id. ({003695FA-5CC6-4572-9916-799609577319} - 209). Right now the dataset only contains 7,8,9 districts. The others will be offered at the end of the Feburary.

Data Wrangling

Property data

# # replace "and" with "&"
# pprProperties <- pprProperties %>% 
#   mutate(OFFICIAL_NAME = gsub("and", "&", pprProperties$OFFICIAL_NAME),
#          PUBLIC_NAME = gsub("and", "&", pprProperties$PUBLIC_NAME))
# 
# 
# # join method 1
# property.join1 <- left_join(propertyArea, 
#                           pprProperties %>% dplyr::select(ADDRESS_911, geometry), 
#                           by=c("X911.Address"="ADDRESS_911"), left=FALSE) %>% 
#   filter(!st_is_empty(geometry))
# 
# # join method 2
# property.join2 <- left_join(propertyArea, 
#                           pprProperties %>% dplyr::select(OFFICIAL_NAME, geometry), 
#                           by=c("PPR.Site.Name"="OFFICIAL_NAME"), left=FALSE) %>% 
#   filter(!st_is_empty(geometry))
# 
# # join method 3
# property.join3 <- left_join(propertyArea, 
#                           pprProperties %>% dplyr::select(PUBLIC_NAME, geometry), 
#                           by=c("PPR.Site.Name"="PUBLIC_NAME"), left=FALSE) %>% 
#   filter(!st_is_empty(geometry))
# 
# # combine 3 methods together
# property <- rbind(property.join1,property.join2) %>% 
#   rbind(property.join3,.) %>% 
#   distinct() %>% 
#   st_sf()
# 
# x <- left_join(propertyArea, property, by="PPR.Site.Name") %>% 
#   filter(st_is_empty(geometry))


# According to the email, we should directly use pprProperties to spatial join the service area to get the service area information. Therefore, the above code should be delete.


property <- st_join(st_centroid(pprProperties),pprServiceArea,left=TRUE) %>% 
  st_drop_geometry() %>% 
  left_join(pprProperties %>% dplyr::select(OBJECTID,geometry),by='OBJECTID') %>% 
  st_sf() %>% 
  st_transform(crs = 4326) %>% 
  dplyr::select(-Shape__Length,-Shape__Area,-Shape_Leng,-Shape_Area) %>% 
  rename('ServiceAreaID' = 'INFO')
# map the location of properties in district 7,8,9
ggplot() + 
  geom_sf(data=property %>% filter(PPR_DIST %in% c(7,8,9)),color=palette1_main,fill = palette1_main)+
  geom_sf(data=st_union(pprDestServiceArea %>% filter(PPR_DIST ==7)),color="black",size=2,fill = "transparent")+
  geom_sf(data=st_union(pprDestServiceArea %>% filter(PPR_DIST ==8)),color="black",size=2,fill = "transparent")+
  geom_sf(data=st_union(pprDestServiceArea %>% filter(PPR_DIST ==9)),color="black",size=2,fill = "transparent")+
  geom_sf(data=pprDestServiceArea,color="black",size=0.75,linetype ="dashed",fill = "transparent")+
  labs(title = "", 
       subtitle = "",
       x="",y="")+
  mapTheme()
Figure. Locations of properties in District 7,8,9

Figure. Locations of properties in District 7,8,9

Through above wrangling, we obtain the newest data about property and link them with service areas. The map only map the properties in the district 7/8/9

Program data

# define date 
program2021.clean <- program2021 %>% 
  mutate(AttendanceWeekDate = mdy(AttendanceWeekDate),
         DateFrom = mdy(DateFrom),
         DateTo = mdy(DateTo))

# create a df only containing records without program scheduel info
program2021.NA <- program2021.clean[is.na(program2021.clean$ProgramScheduleID),]

# filter by attendance date
program2021.clean <- program2021.clean %>% 
  filter(AttendanceWeekDate > DateFrom & AttendanceWeekDate < DateTo)

# original data is recorded by week, here we change it into being recorded by occurence
program2021.clean <- separate(program2021.clean, Days,into= c("1","2","3","4","5","6","7"))

program2021.clean <- program2021.clean %>% 
  gather(colNames, weekday, 15:21) %>% 
  select(-colNames) %>% 
  na.omit(cols='weekday')

# create exact attendance date
program2021.clean <- program2021.clean %>% 
  mutate(AttendenceRealDate = case_when(
    weekday == "Monday" ~ AttendanceWeekDate,
    weekday == "Tuesday" ~ AttendanceWeekDate+1,
    weekday == "Wednesday" ~ AttendanceWeekDate+2,
    weekday == "Thursday" ~ AttendanceWeekDate+3,
    weekday == "Friday" ~ AttendanceWeekDate+4,
    weekday == "Saturday" ~ AttendanceWeekDate+5,
    weekday == "Sunday" ~ AttendanceWeekDate+6,
  ))

Through above wrangling, we obtain the real attendance date for each event. (p.s. a program may have more than one events which links with different program schedualed ids)

program2021.join <- left_join(program2021.clean, facilityID, by =c("FacilityID" = "FacilityID")) %>% 
  left_join(., property, by =c("PPR_Properties_ObjectID"="OBJECTID"))

# get the failed joining items
program2021.join.na <- program2021.join[is.na(program2021.join$PPR_Properties_ObjectID),]

# filter the failed joining items
program2021.join <- program2021.join %>% drop_na(PPR_Properties_ObjectID)

Through above wrangling, we link program data to their based properties,their belonged Service Area.

SafeGraph Data

# filter into philly
safeGraph <- patternAllMonth %>% 
  filter(city == "Philadelphia")

# join with POI and brand data
safeGraph <- safeGraph %>%
  left_join(core_poi %>% dplyr::select(placekey,location_name,top_category,sub_category,naics_code,latitude,longitude),
            by=c("placekey"="placekey","location_name" = "location_name"),keep=FALSE)
# safeGraph <- safeGraph %>%
#   left_join(core_poi, by=c("placekey","parent_placekey","location_name","street_address","city","region","postal_code","safegraph_brand_ids","brands"),keep=FALSE) %>%
#   left_join(brand_info, by=c("safegraph_brand_ids"="safegraph_brand_id","brands"="brand_name","top_category","sub_category","naics_code"),keep=FALSE)

# create geometry from lat & lng
safeGraph.geo <- 
  safeGraph %>%
  st_as_sf(coords = c("longitude", "latitude"), crs = 4326, agr = "constant", na.fail=FALSE)
# change workers number by yourself
plan(multiprocess, workers = 10)


# keep congeneric bussiness
congenericMoves <-
  safeGraph.geo %>%
  filter(top_category %in% c("Promoters of Performing Arts, Sports, and Similar Events",
                             "Other Amusement and Recreation Industries",
                             "Museums, Historical Sites, and Similar Institutions") | str_detect(location_name, "Park") | str_detect(location_name, "Playground") | str_detect(location_name, "Recreation Center")) %>%
  filter(str_detect(location_name, "Parking", negate = TRUE))


# Keep only ppr sites
#712190:Nature Parks and Other Similar Institutions; 
#713990:All Other Amusement and Recreation Industries; 
#713940: Fitness and Recreational Sports Centers; 
#711310:Promoters of Performing Arts, Sports, and Similar Events
parks <- safeGraph.geo %>% 
  dplyr::select(placekey, naics_code, location_name) %>% 
  distinct() %>% 
  filter(naics_code %in% c(712190, 713990, 713940, 711310) | str_detect(location_name, "Park") | str_detect(location_name, "Playground") | str_detect(location_name, "Recreation Center")) %>%
  filter(str_detect(location_name, "Parking", negate = TRUE)) %>% 
  st_transform(crs = 4326)

PPRmoves <- safeGraph.geo %>% 
  filter(placekey %in% as.list(parks$placekey))

# join filtered safeGraph place with ppr property

propertyWithPlaceKey <- st_join(property %>% st_buffer(10),parks %>% dplyr::select(placekey, geometry),left=FALSE) %>%
  st_drop_geometry() %>% 
  left_join(property %>% dplyr::select(OBJECTID),by=('OBJECTID'='OBJECTID')) %>% 
  st_sf() %>% 
  st_transform(crs=4326) %>% 
  drop_na(placekey)

# count
print(paste0("The number of PPR properties is ", n_distinct(property$PUBLIC_NAME),"The number joined properties is ", n_distinct(propertyWithPlaceKey$PUBLIC_NAME)))

In the above map, the polygon is the properties of PPR, the green dots are the successfully join properties with placekey

program2021.joinWithPlaceKey <- 
  st_join(program2021.join %>%
            st_sf() %>% 
            st_transform(crs=4326) %>%
            st_buffer(10),
          parks %>% dplyr::select(placekey, geometry),left=FALSE) %>%
  st_drop_geometry() %>%  
  merge.data.frame(program2021.join %>%
                     dplyr::select(geometry),
                   by='row.names')%>%
  dplyr::select(-Row.names) %>% 
  st_sf() %>% 
  st_transform(crs=4326)

mapview(property)+mapview(program2021.joinWithPlaceKey,col.regions = "red")

EXPLORATORY – CENSUS DATA

1. Get each of the Philadelphia PPR zones

ggplot() + 
  geom_sf(data=ll(st_union(pprDistrict)),color="black",size=2,fill = "transparent",inherit.aes = FALSE)+
  geom_sf(data=ll(pprDistrict),color=palette1_main,size=2,fill = "transparent",inherit.aes = FALSE)+
  labs(title = "", 
       subtitle = "",
       x="",y="")+
  mapTheme()

2. Get the list of PHL census tracts that intersect with each zone

# ggplot(PPRmoves)+
#   geom_line(aes(x = date_range_start, y = raw_visit_counts))+
#   facet_wrap(~location_name, scales = "free")

Loading Data into Database

EXPLORATORY – SafeGrpah DATA

sumVisit <- visitCount %>%
  dplyr::select(-visitDay,-day,-month) %>% 
  group_by(placekey) %>%
  summarise(visits=sum(visits))

ggplot(sumVisit)+
  geom_sf(data=pprServiceArea,
          color='black',
          size=0.25,
          fill= "transparent")+
  geom_sf(data=pprServiceArea %>% filter(PPR_DIST %in% c(7,8,9)),
          color='black',
          size=0.5,
          fill= "transparent")+
  geom_sf(aes(size = visits),
          color = palette1_main,
          fill = palette1_main,
          alpha = 0.3) +
  scale_size_continuous(range = c(1, 3),
                        name = "Visits")+
  mapTheme()+
  theme(legend.position = "bottom",
        legend.key.width = unit(1.5, 'cm'),
        legend.key.height  = unit(1.2, 'cm'))
Figure. Map of total visits

Figure. Map of total visits

The above is the aggragated visits map of PPR sities. The data is from safegraph.

visitCount789 <- 
  st_join(visitCount %>% st_transform(crs=4326),pprServiceArea%>% st_transform(crs=4326),left=TRUE) %>% 
  filter(PPR_DIST %in% c(7,8,9))

visitCount789 <- visitCount789 %>% 
  dplyr::select(placekey,visits) %>% 
  st_drop_geometry() %>% 
  group_by(placekey) %>% 
  mutate(totalVisits = sum(visits)) %>% 
  dplyr::select(-visits) %>% 
  distinct()

From above, we can know Christy Recreation Center() has the most frequent visits among district 7,8,9. The total visits is 420776

Figure Matthias Baldwin Park

Figure Matthias Baldwin Park

Figure Matthias Baldwin Park

Figure Matthias Baldwin Park

sumVisit <- dwellTime %>% 
  filter(placekey=='zzz-222@63s-dvq-5fz') %>% 
  dplyr::select(-month) %>% 
  group_by(dwellTimes) %>%
  summarise(visitors=sum(visitors)) %>% 
  st_drop_geometry() 

sumVisit$dwellTimes <- factor(sumVisit$dwellTimes, levels= c("<5","5-10","11-20","21-60","61-120","121-240",">240" ))

sumVisit%>%
  ggplot(aes(dwellTimes,visitors)) +
  geom_bar(position ="dodge",fill = palette1_main,stat='identity') +
  labs(x="Dwell Time", y="Aggregated Visitors",
       title ='Christy Recreation Center (zzz-222@63s-dvq-5fz)') +
  plotTheme(10,20)
Figure. Map of dwell time

Figure. Map of dwell time

visitCount %>% 
  filter(placekey=='zzz-222@63s-dvq-5fz') %>% 
  st_drop_geometry()%>%
  na.omit()%>%
  ggplot(aes(visitDay,visits)) + 
  geom_line(color=palette1_main,size=1)+
  labs(title = 'Christy Recreation Center (zzz-222@63s-dvq-5fz)',x="Visit Date",y="Safegraph Visit")+
  plotTheme(10,20)+
  theme(panel.border = element_rect(colour = "black", fill=NA, size=1))
Figure. Map of dwell time

Figure. Map of dwell time

sumVisit <- visitHour %>% 
  filter(placekey=='zzz-222@63s-dvq-5fz') %>% 
  dplyr::select(-month) %>% 
  group_by(hour) %>%
  summarise(visits=sum(visit)) %>% 
  st_drop_geometry()

sumVisit%>%
  ggplot(aes(hour,visits)) +
  geom_bar(position ="dodge",fill = palette1_main,stat='identity') +
  labs(x="hour", y="Aggregated Visits",
       title ='Christy Recreation Center (zzz-222@63s-dvq-5fz)') +
  plotTheme(10,20)
Figure. Map of visit time

Figure. Map of visit time

ggplot(data = orgCountPlot2) + 
  geom_sf(data = pprServiceArea %>% st_transform(crs=4326),fill ="transparent", color="black",size=0.5)+
  geom_sf(data=pprDistrict %>% st_transform(crs=4326),fill ="transparent", color="black",size=1)+
  geom_curve(aes(x = origin.x, 
                 y = origin.y, 
                 xend = park.x, 
                 yend = park.y,
                 color = q5(visitors)),
             size = 0.5,
             curvature = -0.2, 
             alpha = 0.4,
             arrow = arrow(length = unit(0.01, "npc")))+
  scale_color_manual(values = palette5,
                     labels = qBr(orgCountPlot2,"visitors"),
                     name = "Visitors (Quintile Breaks)") +
  labs(x="",y="")+
  mapTheme()+
  theme(legend.position = "bottom",panel.spacing = unit(6, 'lines'),
        legend.key.width = unit(0.5, 'cm'),
        legend.key.height  = unit(0.2, 'cm'))
Figure. Flow map of parks and origins

Figure. Flow map of parks and origins

ggplot(data = orgCountPlotHF) + 
  geom_sf(data = pprServiceArea %>% st_transform(crs=4326),fill ="transparent", color="black",size=1)+
  geom_sf(data=pprDistrict %>% st_transform(crs=4326),fill ="transparent", color="black",size=2)+
  geom_curve(aes(x = origin.x, 
                 y = origin.y, 
                 xend = park.x, 
                 yend = park.y),
             size = 2.5,
             color = palette1_main,
             curvature = -0.2, 
             alpha = 0.4,
             arrow = arrow(length = unit(0.01, "npc")))+
  labs(x="",y="")+
  mapTheme()+
  theme(legend.position = "bottom",panel.spacing = unit(6, 'lines'),
        legend.key.width = unit(1.5, 'cm'),
        legend.key.height  = unit(1.2, 'cm'))
Figure. Flow map of parks and origins - High Frequency

Figure. Flow map of parks and origins - High Frequency

ggplot(data = depaCountPlot2) + 
  geom_sf(data = pprServiceArea %>% st_transform(crs=4326),fill ="transparent", color="black",size=0.5)+
  geom_sf(data=pprDistrict %>% st_transform(crs=4326),fill ="transparent", color="black",size=1)+
  geom_curve(aes(x = departure.x, 
                 y = departure.y, 
                 xend = park.x, 
                 yend = park.y,
                 color = q5(visitors)),
             size = 0.5,
             curvature = -0.2, 
             alpha = 0.4,
             arrow = arrow(length = unit(0.01, "npc")))+
  scale_color_manual(values = palette5,
                     labels = qBr(depaCountPlot2,"visitors"),
                     name = "Visitors (Quintile Breaks)") +
  labs(x="",y="")+
  mapTheme()+
  theme(legend.position = "bottom",panel.spacing = unit(6, 'lines'),
        legend.key.width = unit(0.5, 'cm'),
        legend.key.height  = unit(0.2, 'cm'))
Figure. Flow map of parks and departure points

Figure. Flow map of parks and departure points

ggplot(data = depaCountPlotHF) + 
  geom_sf(data = pprServiceArea %>% st_transform(crs=4326),fill ="transparent", color="black",size=0.5)+
  geom_sf(data=pprDistrict %>% st_transform(crs=4326),fill ="transparent", color="black",size=1)+
  geom_curve(aes(x = departure.x, 
                 y = departure.y, 
                 xend = park.x, 
                 yend = park.y),
             size = 0.5,
             color = palette1_main,
             curvature = -0.2, 
             alpha = 0.4,
             arrow = arrow(length = unit(0.01, "npc")))+
  labs(x="",y="")+
  mapTheme()+
  theme(legend.position = "bottom",panel.spacing = unit(6, 'lines'),
        legend.key.width = unit(0.5, 'cm'),
        legend.key.height  = unit(0.2, 'cm'))
Figure. Flow map of parks and departure - High Frequency

Figure. Flow map of parks and departure - High Frequency

dwellTimeForPlot <- dwellTime %>% 
  mutate(dwellTimes = recode(dwellTimes,
                             "<5" = 2.5,
                             "5-10" = 7.5,
                             "11-20" = 15,
                             "21-60" = 40,
                             "61-120" = 90,
                             "121-240" = 180,
                             ">240" = 0)) %>%
  mutate(sepTotalDwellTime = (visitors*dwellTimes)) %>% 
  group_by(placekey) %>% 
  mutate(totalVisitors=sum(visitors) )%>%
  filter(totalVisitors>50) %>% 
  mutate(avgDwellTime=sum(sepTotalDwellTime)/totalVisitors) %>% 
  dplyr::select(placekey,avgDwellTime) %>% 
  distinct()

ggplot(dwellTimeForPlot)+
  geom_sf(data=pprServiceArea,
          color='black',
          size=0.25,
          fill= "transparent")+
  geom_sf(data=pprDistrict,
          color='black',
          size=0.75,
          fill='transparent')+
  geom_sf(aes(size = avgDwellTime,
              color = avgDwellTime),
          alpha = 0.5) +
  scale_size_continuous(range = c(1, 3),
                        name = "avgDwellTime")+
  scale_color_continuous(low = '#FFDEDB',high ='#FF2903',
                     name = "avgDwellTime") +
  mapTheme()+
  theme(legend.position = "bottom",
        legend.key.width = unit(0.5, 'cm'),
        legend.key.height  = unit(0.2, 'cm'))
Figure. Map of dwell time

Figure. Map of dwell time

From the above plot we can see the largest dwelling time is at Girard Park () with avgerage dwelling time is 94.9. Interestingly, there is not program by PPR in this park in 2021. There is a activity organized by citizens themselves. The activity is yoga, from April to September, every 1pm to 2pm on Sunday.

Longest Dwell Time

Figure Matthias Baldwin Park

Figure Matthias Baldwin Park

sumVisit <- dwellTime %>% 
  filter(placekey=='zzz-222@628-pgb-k75') %>% 
  dplyr::select(-month) %>% 
  group_by(dwellTimes) %>%
  summarise(visitors=sum(visitors)) %>% 
  st_drop_geometry() 

sumVisit$dwellTimes <- factor(sumVisit$dwellTimes, levels= c("<5","5-10","11-20","21-60","61-120","121-240",">240" ))

sumVisit%>%
  ggplot(aes(dwellTimes,visitors)) +
  geom_bar(position ="dodge",fill = palette1_main,stat='identity') +
  labs(x="Dwell Time", y="Aggregated Visitors",
       title ='Girard Park (zzz-222@628-pgb-k75)') +
  plotTheme(10,20)
Figure. Map of dwell time

Figure. Map of dwell time

visitCount %>% 
  filter(placekey=='zzz-222@628-pgb-k75') %>% 
  st_drop_geometry()%>%
  na.omit()%>%
  ggplot(aes(visitDay,visits)) + 
  geom_line(color=palette1_main,size=1)+
  labs(title = 'Girard Park',x="Visit Date",y="Safegraph Visit")+
  plotTheme(10,20)+
  theme(panel.border = element_rect(colour = "black", fill=NA, size=1))
Figure. Map of dwell time

Figure. Map of dwell time

sumVisit <- visitHour %>% 
  filter(placekey=='zzz-222@628-pgb-k75') %>% 
  dplyr::select(-month) %>% 
  group_by(hour) %>%
  summarise(visits=sum(visit)) %>% 
  st_drop_geometry()

sumVisit%>%
  ggplot(aes(hour,visits)) +
  geom_bar(position ="dodge",fill = palette1_main,stat='identity') +
  labs(x="hour", y="Aggregated Visits",
       title ='Girard Park (zzz-222@628-pgb-k75)') +
  plotTheme(10,20)
Figure. Map of visit time

Figure. Map of visit time